perm filename FILLR.F4[CMS,LCS] blob
sn#096339 filedate 1974-04-11 generic text, type T, neo UTF8
00100 SUBROUTINE FILLER(Q,R,NE,M,NP)
00200 DIMENSION Q(1),R(1),NE(1)
00300 KK=NE(1)
00400 KJ=2
00500 DO 4 K=2,KK
00600 IF(NE(K).NE.3)GO TO 11
00700 NE(K)=KJ
00800 KJ=K+1
00900 GO TO 4
01000 11 NE(K)=0
01100 4 CONTINUE
01200 NE(KK+1)=KJ
01300 C FINDS JUMPS
01400 DO 2 J=2,KK
01500 IF(NE(J).GT.0.OR.IFIX(Q(J)).EQ.IFIX(Q(J-1)))GO TO 2
01600 C SKIPS VERTICAL LINES
01700 X=HALF(Q,J)+.00001
01800 C MIDPOINT OF LINE
01900 ALT=HALF(R,J)
02000 C THE ALTITUDE
02100 KJ=0
02200
02300 100 DO 3 L=2,KK
02400 IF(L.EQ.J.OR.NE(L).GT.0)GO TO 3
02500 C NEXT FINDS LINE OVERLAP
02600 CC IF(MISS(L,X,Q,R))3,40,5
02700 IF(MISS(L,X,Q,R))3,40,40
02800 CC5 IF(Q(L).EQ.Q(L-1))GO TO 40
02900 CC IF(POINT(L,Q,R,NE))GO TO 3
03000 C NEXT FINDS ALT. OF CROSSING
03100 40 Y=HGHT(L,X,Q,R)
03200 IF(Y.LT.ALT)KJ=KJ+1
03300 3 CONTINUE
03400 IF(MOD(KJ,2).EQ.0)GO TO 2
03500 C FOUND A LINE TO DRAW LINES DOWN FROM.
03600 NE(J)=-1
03700 X=-1
03800 KJ=M
03900 N=Q(J)
04000 L=Q(J-1)
04100 IF(N.LT.L)GO TO 33
04200 KJ=-KJ
04300 N=N-1
04400 GO TO 34
04500 33 N=N+1
04600 34 JA=3
04700 X=-1
04800
04900 17 DO 6 K=N,L,KJ
05000 RK=K
05100 Y=HGHT(J,RK,Q,R)
05200 IF(X)CALL LINES(RK,Y,JA,M)
05300 JA=2
05400 H=-10000
05500
05600 18 DO 7 I=2,KK
05700 IF(NE(I).NE.0)GO TO 7
05800 C SKIP IF SAME LINE.
05900 IF(MISS(I,RK,Q,R))GO TO 7
06000 C TRY NEXT POINT IF IT HIT A -1 LINE.
06100 9 B=HGHT(I,RK,Q,R)
06200 IF(B.GT.Y)GO TO 7
06300 IF(B.LE.H)GO TO 7
06400 H=B
06500 C FOUND HIGHEST NEW POINT
06600 7 CONTINUE
06700 IF(H.EQ.Y)GO TO 31
06800 C WIPES OUT THIS LINE SEG.
06900 IF(H.NE.-10000)GO TO 31
07000 X=1
07100 GO TO 6
07200 31 CALL LINES(RK,H,JA,M)
07300 IF(X.GT.0)CALL LINES(RK,Y,JA,M)
07400 302 X=-X
07500 6 CONTINUE
07600 2 CONTINUE
07700
07800 301 IF(M.GE.6)CALL DPYOUT(NP)
07900 END
08000
08100 FUNCTION HGHT(J,A,Q,R)
08200 DIMENSION Q(1),R(1)
08300 B=R(J-1)
08400 D=Q(J-1)
08500 F=Q(J)
08600 HGHT=((R(J)-B)*(A-D))/(F-D)+B
08700 IF(A.EQ.D)HGHT=B
08800 END
08900
09000
09100 FUNCTION MISS(J,A,Q,R)
09200 DIMENSION Q(1),R(1)
09300 B=Q(J)
09400 C=Q(J-1)
09500 MISS=0
09600 IF(B.GT.A)GO TO 1
09700 IF(B.NE.A)GO TO 2
09800 MISS=1
09900 RETURN
10000 2 IF(C.LE.A)GO TO 3
10100 RETURN
10200 1 IF(C.LT.A)RETURN
10300 3 MISS=-1
10400 END
10500 C MISS=-1, HIT=0, POINT=1
10600
10700 FUNCTION HALF(A,J)
10800 DIMENSION A(1)
10900 HALF=(A(J-1)-A(J))/2.+A(J)
11000 RETURN
11100 END
11200 SUBROUTINE LINES(A,B,J,I)
11300 M=A
11400 N=B
11500 IF(IABS(I).LT.6)GO TO 2
11600 IF(J.EQ.3)GO TO 1
11700 CALL AVECT(M,N)
11800 RETURN
11900 1 CALL AIVECT(M,N)
12000 RETURN
12100 2 CALL PLOT(M,N,J)
12200 RETURN
12300 END